Especial Multimedia/Especial Multimedia.iso/Multimed/Prg/KALENDAR.ZIP/TEST3.FRM

Text File | 1997-09-14 | 8KB | 270 lines

VERSION 2.00
Begin Form Form3
   BackColor       =   &H00C0C0C0&
   Caption         =   "Drag 'N Drop (and DrawOnDay event)"
   ClientHeight    =   3780
   ClientLeft      =   3210
   ClientTop       =   645
   ClientWidth     =   7005
   Height          =   4470
   Left            =   3150
   LinkTopic       =   "Form3"
   ScaleHeight     =   3780
   ScaleWidth      =   7005
   Top             =   15
   Width           =   7125
   Begin PictureBox pctTop
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Height          =   600
      Left            =   0
      ScaleHeight     =   570
      ScaleWidth      =   6975
      TabIndex        =   1
      Top             =   0
      Width           =   7005
      Begin TextBox Text1
         DragIcon        =   TEST3.FRX:0000
         Height          =   300
         Left            =   4290
         TabIndex        =   2
         Text            =   "Text1"
         Top             =   0
         Width           =   2010
      End
      Begin Label Label2
         BackColor       =   &H00C0C0C0&
         Caption         =   "Or, drag a date from the Kalendar to the Text Box or another date."
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   210
         Left            =   60
         TabIndex        =   4
         Top             =   300
         Width           =   5775
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Type something here and drag it to the Kalendar."
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   210
         Left            =   75
         TabIndex        =   3
         Top             =   60
         Width           =   4230
      End
   End
   Begin Kalendar Kalendar1
      ArrowDelay      =   500
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      CalendarFormat  =   0  'Month
      ChgOnOtherMon   =   -1  'True
      DateDispStyle   =   2  'User
      DayAlignment    =   0  'Upper Left
      DOWAlign        =   2  'Center
      DOWBackColor    =   &H00808080&
      DOWBorder       =   -1  'True
      DOWDispStyle    =   2  'Medium
      DOWFontBold     =   0   'False
      DOWFontItalic   =   0   'False
      DOWFontName     =   "Arial"
      DOWFontSize     =   10
      DOWFontStrikeThru=   0   'False
      DOWFontUnderline=   0   'False
      DOWForeColor    =   &H00FFFFFF&
      DragIcon        =   TEST3.FRX:0302
      EnableKeys      =   0   'False
      FirstDOW        =   0  'Sunday
      FixedDayHeight  =   0   'False
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   3255
      Language        =   0  'English
      Left            =   0
      LineColor       =   &H00000000&
      MonAlign        =   2  'Center
      MonBackColor    =   &H00C0C0C0&
      MonDispStyle    =   2  'Month/Year
      MonFontBold     =   0   'False
      MonFontItalic   =   0   'False
      MonFontName     =   "Times New Roman"
      MonFontSize     =   14
      MonFontStrikeThru=   0   'False
      MonFontUnderline=   0   'False
      MonForeColor    =   &H00000000&
      OtherMonBackColor=   &H00C0C0C0&
      OtherMonForeColor=   &H00FFFFFF&
      SelDayBackColor =   &H00C0C0C0&
      SelDayForeColor =   &H00000000&
      ShowAllDays     =   0   'False
      ShowArrows      =   -1  'True
      ShowLines       =   -1  'True
      ShowSelection   =   0   'False
      TabIndex        =   0
      Text            =   "06/16/94"
      TextFormat      =   0  'mdy
      Top             =   585
      Width           =   6435
   End
   Begin Label lblFont
      Caption         =   "FontLable"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00008000&
      Height          =   285
      Left            =   6450
      TabIndex        =   5
      Top             =   1980
      Visible         =   0   'False
      Width           =   555
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFPrint
         Caption         =   "&Print"
      End
   End
End
Option Explicit

Dim draggingDay As Variant

Dim couldDrag As Integer
Dim downAtX As Single, downAtY As Single

Dim txtHeight As Long       ' Used to determine how much space is required to show the day numbers.
                ' It is set differently for the printer and the screen.

Sub Form_Activate ()
    SetDescription Sample3Description()
End Sub

Sub Form_Load ()
    Kalendar1.Text = Date

    txtHeight = TextHeight("I") / Screen.TwipsPerPixelY
End Sub

Sub Form_Resize ()
    If Form3.ScaleWidth > 0 And Form3.ScaleHeight - pctTop.Height > 0 Then
    Kalendar1.Move 0, pctTop.Height, Form3.ScaleWidth, Form3.ScaleHeight - pctTop.Height
    End If
End Sub

Sub Kalendar1_DragDrop (Source As Control, x As Single, y As Single)
    Kalendar1.PointX = x
    Kalendar1.PointY = y

    If Kalendar1.DateAtPoint <> "" Then

    If TypeOf Source Is TextBox Then
        DateInfoAdd (Kalendar1.DateAtPointJul), (Text1.Text)
        Text1.Text = ""
    Else
        DateInfoMove (draggingDay), (Kalendar1.DateAtPointJul)
    End If
    Kalendar1.Refresh
    End If
End Sub

Sub Kalendar1_DrawOnDay (hDC As Integer, State As Integer, theDay As Long, x As Single, y As Single, x2 As Single, y2 As Single)
Dim r As Rect
Dim StrTmp As String
    '--- Draw out some text
    StrTmp = GetDateInfo(theDay)

    If Len(StrTmp) > 0 Then
    '--- Make a Windows API rectangle to draw in.
    KalWindowAPIRect x, y, x2, y2, r
    InflateRect r, -1, -1
    r.top = r.top + txtHeight
    KalDrawText hDC, theDay, r, StrTmp, lblFont, False
    End If

End Sub

Sub Kalendar1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)

    Kalendar1.PointX = x
    Kalendar1.PointY = y

    If Kalendar1.DateAtPoint <> "" Then
    downAtX = x
    downAtY = y
    couldDrag = True
    End If
End Sub

Sub Kalendar1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)

    If couldDrag And (Abs(downAtX - x) > 75 Or Abs(downAtY - y) > 75) Then
    couldDrag = False
    Kalendar1.Drag 1
    draggingDay = Kalendar1.DateAtPointJul
    End If
End Sub

Sub Kalendar1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)

    couldDrag = False
    Kalendar1.Drag 2
End Sub

Sub mnuFPrint_Click ()
Dim saveBackColor As Long

    saveBackColor = Kalendar1.MonBackColor
    txtHeight = TextHeight("I") / Printer.TwipsPerPixelY

    Kalendar1.MonBackColor = RGB(255, 255, 255)
    Kalendar1.PrintHDC = Printer.hDC
    Kalendar1.PrintAction = KAL_PRINT_PORTRAIT

    Kalendar1.MonBackColor = saveBackColor
    txtHeight = TextHeight("I") / Screen.TwipsPerPixelY

    Printer.EndDoc
End Sub

Function Sample3Description () As String
Dim s As String

    s = "This sample shows drag and drop implemented in a Kalendar. The "
    s = s & "DrawOnDay event is used to display the text. " & CR
    s = s & "NOTE: Maximize the window to see more of the text."

    Sample3Description = s
End Function

Sub Text1_DragDrop (Source As Control, x As Single, y As Single)
    Text1.Text = GetDateInfo((draggingDay))
End Sub

Sub Text1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
    Text1.Drag 1
End Sub

Sub Text1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
    Text1.Drag 2
End Sub